home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rpcxlb10.zip / RPCXDEMO.PRG < prev    next >
Text File  |  1993-08-12  |  16KB  |  623 lines
  1. *--------------------------------------------------------------------------
  2. * RPCXDemo.PRG - Program to demonstrate the use of the functions
  3. *                in the graphic RPCXLib library for Clipper
  4. *
  5. * This demo has been written for Clipper version 5.xx
  6. *
  7. * Compile    :    CLIPPER RPCXDEMO /N
  8. *
  9. * Link       :    RTLINK  file RPCXDEMO lib RPCXLIB    - or -
  10. *        BLINKER file RPCXDEMO lib RPCXLIB
  11. *
  12. * Syntax     :  RPCXDEMO [d:][\path]
  13. *        [d:][\path] : directory where PCX-files are located
  14. *--------------------------------------------------------------------------
  15. * Date       :  11/08/93
  16. *--------------------------------------------------------------------------
  17. * Author     :  Rolf van Gelder
  18. *               Binnenwiertzstraat 27
  19. *               5615 HG  EINDHOVEN
  20. *        THE NETHERLANDS
  21. *
  22. * E-Mail     :  Internet: RCROLF@urc.tue.nl
  23. *               BitNet  : RCROLF@heitue5
  24. *--------------------------------------------------------------------------
  25. * (c) 1993  Rolf van Gelder  -  All rights reserved
  26. *--------------------------------------------------------------------------
  27. MEMVAR    GetList                && To eliminate Clipper /W warning
  28.  
  29. *--------------------------------------------------------------------------
  30. * Standard Clipper HEADER files
  31. *--------------------------------------------------------------------------
  32. #include "Inkey.ch"
  33. #include "AChoice.ch"
  34. #include "SetCurs.ch"
  35. #include "Directry.ch"
  36.  
  37. *--------------------------------------------------------------------------
  38. * RPCXLIB HEADER FILE
  39. *--------------------------------------------------------------------------
  40. #include "RPCXLib.ch"
  41.  
  42. *--------------------------------------------------------------------------
  43. * Static array (used by different functions)
  44. *--------------------------------------------------------------------------
  45. *-- Initialize the array with error messages (from RPCXLib.CH)
  46. STATIC    aPCXError := PL_ERRMSG
  47.  
  48. *--------------------------------------------------------------------------
  49. *
  50. *                         Main function : RPCXDemo
  51. *
  52. *--------------------------------------------------------------------------
  53.  
  54. FUNCTION R_PCXDemo ( cDrvPath )
  55.  
  56. LOCAL    nSVGA     := R_VGACard ()    && Number of SVGA card
  57. LOCAL    aDrivers  := PL_SVGA_NAMES    && Names of the SVGA cards
  58.  
  59. LOCAL    cGraphDrv            && Description SVGA card
  60. LOCAL    cGraphSys := 'UNKNOWN'        && Description Graphic System
  61.  
  62. LOCAL    cGraphMsg            && Text buffer
  63.  
  64. LOCAL    nFiles                && Number of PCX-files in directory
  65. LOCAL    nBottom                && Last line for AChoice window
  66.  
  67. LOCAL    aPCXList  := {}            && Array with PCX-file info
  68. LOCAL    aValid    := {}            && Selectable items for AChoice
  69. LOCAL    aPCXDir   := {}            && Directory info PCX-files
  70.  
  71. LOCAL    nChoice   := 1            && Sequence number chosen file
  72. LOCAL    nLastKey            && Keycode
  73. LOCAL    cFile                && Name of PCX-file
  74. LOCAL    nVidMode  := R_VMGet ()        && Original video mode
  75. LOCAL    nRetCode            && Return code of R_ShowPCX
  76. LOCAL    cScreen                && Screen buffer
  77. LOCAL    cSpec                && Filespec PCX-file
  78. LOCAL    cComment            && Comment on PCX-file
  79. LOCAL    i                && Counter
  80. LOCAL    n                && Help variable
  81. LOCAL    nRed                && Red   component
  82. LOCAL    nGreen                && Green component
  83. LOCAL    nBlue                && Blue  component
  84.  
  85. LOCAL    aBWhite := PL_DEF_BRIGHT_WHITE    && Composition BRIGHT WHITE
  86. LOCAL    aWhite  := PL_DEF_WHITE        && Composition WHITE
  87. LOCAL    aYellow := PL_DEF_YELLOW    && Composition YELLOW
  88.  
  89. LOCAL    cPalette            && Palette buffer
  90. LOCAL    cPalOrg := R_SavePal ()        && Save original palette
  91.  
  92. *-- Install the default Clipper palette (just to be sure ...)
  93. R_DefPal ()
  94.  
  95. *-- Mix a special GREEN colour for the background :
  96. *--    5 x RED + 30 x GREEN + 30 x BLUE
  97. R_SetRGB ( PL_GREEN, 5, 30, 30 )
  98.  
  99. *-- Determine the number of PCX-files in the current directory
  100. IF cDrvPath != NIL
  101.    *-- Path passed as command line parameter
  102.  
  103.    *-- Append a backslash (if needed)
  104.    cDrvPath := Trim ( cDrvPath )
  105.  
  106.    IF Right ( cDrvPath, 1 ) != ':'
  107.       *-- Path has been given
  108.  
  109.       IF Right ( cDrvPath, 1 ) != '\'
  110.          *-- Path doesn't end with a backslash : append !
  111.  
  112.          cDrvPath += '\'
  113.  
  114.       ENDIF
  115.  
  116.    ENDIF
  117.  
  118. ELSE
  119.    *-- No drive nor path given
  120.  
  121.    cDrvPath := ''
  122.  
  123. ENDIF
  124.  
  125. *-- Get the directory list of the PCX-files
  126. aPCXDir := Directory ( cDrvPath + '*.PCX' )
  127. nFiles  := Len ( aPCXDir )
  128.  
  129. IF nFiles > 0
  130.    *-- PCX-files found !
  131.  
  132.    FOR i := 1 TO nFiles
  133.       *-- Stuff the info of all the PCX-files in an array
  134.  
  135.       AADD ( aValid , GetInfo (cDrvPath+aPCXDir[i,F_NAME], @cSpec, @cComment ) )
  136.       AADD ( aPCXList, PADR ( aPCXDir[i,F_NAME], 12 ) + ' │ ' + ;
  137.          Str ( aPCXDir[i,F_SIZE],6 ) + ' │ ' + ;
  138.          PADR ( cSpec, 16 ) + ' │ ' + PADR ( cComment, 33 ) )
  139.  
  140.    NEXT
  141.  
  142.    *-- Sort the array on file name
  143.    aPCXList := ASORT ( aPCXList )
  144.    
  145. ENDIF
  146.  
  147. IF nSVGA < 1
  148.    *-- SuperVGA unknown or not present !
  149.  
  150.    *-- Determine the graphic system of the PC
  151.    IF R_IsMCGA ()
  152.       cGraphSys := 'MCGA'
  153.       
  154.    ELSEIF R_IsVGA ()
  155.       cGraphSys := 'VGA'
  156.       
  157.    ELSEIF R_IsEGA ()
  158.       cGraphSys := 'EGA'
  159.       
  160.    ENDIF
  161.    
  162. ELSE
  163.    
  164.    cGraphSys := 'SUPERVGA'
  165.  
  166.    *-- Name of the SuperVGA adapter
  167.    cGraphDrv := aDrivers [nSVGA]
  168.    
  169. ENDIF
  170.  
  171. SETCOLOR ( 'W+/G' )
  172. SETBLINK ( .t. )
  173. CLEAR
  174.  
  175. *-- Header text
  176. DEVPOS ( 1, 12 )
  177. DEVOUT ( 'RPCXDemo :  Demo program for the RPCXLib Clipper Library' )
  178.  
  179. SETCOLOR ( 'GR+/G' )
  180. DEVPOS ( 2, 27 )
  181. DEVOUT ( '(c) 1993   Rolf van Gelder' )
  182. SETCOLOR ('W+/G')
  183.  
  184. IF nFiles < 1
  185.    *-- No PCX-files in current directory :
  186.    *--    Just show the graphic configuration
  187.    
  188.    ALERT ( '-+- CONFIGURATION -+-;;;Graphic System: ' + cGraphSys + ;
  189.       IF ( cGraphDrv != nil, ';;;SVGA Adapter: ' + cGraphDrv, nil ) )
  190.    
  191.    ALERT ( 'No PCX-files found !' )
  192.    
  193.    RETURN nil
  194.    
  195. ENDIF
  196.  
  197. *-- Determine the height of the directory listbox
  198. nBottom := Min ( nFiles+6, 16 ) 
  199.  
  200. DEVPOS ( nBottom+1, 11 )
  201. DEVOUT ( '<─┘ = Show file  -+-  <F10> = SlideShow   -+- <Esc> = Quit' )
  202.  
  203. @19,0 TO 22,79
  204. DEVPOS ( 20, 2 )
  205. DEVOUT ( 'MIX BACKGROUND COLOUR         Current values : RED   5'+;
  206.          ' - GREEN 30 -  BLUE 30' )
  207. DEVPOS ( 21, 2 )
  208. DEVOUT ( 'F1=RED    F2=RED        F3=GREEN    F4=GREEN       '+;
  209.          'F5=BLUE    F6=BLUE ' )
  210.  
  211. @4,0 TO nBottom,79 DOUBLE
  212. SETCOLOR ( 'GR+/G' )
  213. @5,2 SAY 'File name    │  Bytes │ Width Height Col │ Video mode / Comment  '
  214.  
  215. *-- Display the graphic configuration on line 23
  216. cGraphMsg := '-+- Graphic System : '+cGraphSys
  217.  
  218. IF cGraphDrv != nil
  219.    
  220.    cGraphMsg += ' -+- SVGA Adapter : '+cGraphDrv
  221.    
  222. ENDIF
  223.  
  224. cGraphMsg += ' -+-'
  225.  
  226. @23, ( 80 - LEN ( cGraphMsg ) ) / 2 SAY cGraphMsg
  227. SETCOLOR ( 'W+/G,W+/R,,,W/G' )
  228.  
  229. cScreen := SAVESCREEN ( 0, 0, MAXROW(), MAXCOL() )
  230.  
  231. *----------------------------------------------------------------
  232. * Main loop for displaying pictures and changing the background
  233. * colour
  234. *----------------------------------------------------------------
  235. DO WHILE .T.
  236.    
  237.    nChoice  := ACHOICE ( 6, 2, nBottom-1, 77, aPCXList, ;
  238.                aValid, 'AchUser', nChoice )
  239.  
  240.    nLastKey := LASTKEY ()
  241.  
  242.    DO CASE
  243.  
  244.    CASE nLastKey = K_ESC
  245.       *-- Quit
  246.       EXIT
  247.  
  248.    CASE nLastKey = K_RETURN
  249.       *-- SHOW CHOSEN FILE
  250.  
  251.       *-- File name PCX-file
  252.       cFile    := cDrvPath + TRIM ( LEFT ( aPCXList [nChoice], 12 ) )
  253.  
  254.       *-- Save current palette to a string
  255.       cPalette := R_SavePal ()
  256.  
  257.       *-- Show the PCX-file on the screen
  258.       nRetCode := R_ShowPCX ( cFile )
  259.    
  260.       IF nRetCode = PL_OKAY
  261.          *-- It went okay !
  262.  
  263.          *-- Show the picture 10 seconds (interruptible)
  264.          INKEY ( 10 )
  265.  
  266.          *-- Restore original video mode
  267.          R_VMSet ( nVidMode )
  268.  
  269.       ENDIF
  270.  
  271.       *-- Restore original palette
  272.       *-- (Palette has been reset by R_VMSet () ....)
  273.       R_RestPal ( cPalette )
  274.  
  275.       *-- Repaint the screen
  276.       RESTSCREEN ( 0, 0, MAXROW(), MAXCOL(), cScreen )
  277.  
  278.       IF nRetCode != PL_OKAY
  279.  
  280.          *-- Error while displaying PCX-file : display error message
  281.  
  282.          ALERT ('-+- Error displaying '+cFile+' -+-;;'+;
  283.             aPCXError[nRetCode])
  284.  
  285.       ENDIF
  286.  
  287.    CASE nLastKey = K_F10
  288.       *-- Slid